home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / env / debuginfo.scm < prev    next >
Text File  |  1995-10-13  |  2KB  |  78 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; Reading/writing debugging info
  5.  
  6. (define (write-debug-info location-info file)
  7.   (call-with-output-file file
  8.     (lambda (port)
  9.  
  10.       (display "Writing ") (display file) (newline)
  11.       (let ((write-table
  12.          (lambda (table comment)
  13.            (display "; " port) (display comment port) (newline port)
  14.            (table-walk (lambda (key datum)
  15.                  (write (list key datum) port)
  16.                  (newline port))
  17.                table)
  18.            (write '- port) (newline port))))
  19.     (write-table package-name-table "Package uid -> name")
  20.     (write-table location-info "Location uid -> (name . package-uid)"))
  21.  
  22.       (display "; Template uid -> name, parent, pc in parent, env maps" port)
  23.       (newline port)
  24.       (table-walk (lambda (id data)
  25.             ;; Fields: (uid name parent pc-in-parent
  26.             ;;            env-maps source)
  27.             (write (list id
  28.                  (let ((name (debug-data-name data)))
  29.                    (if name
  30.                        (name->symbol name)
  31.                        #f))
  32.                  (let ((p (debug-data-parent data)))
  33.                    ;; we'd like to (note-debug-data! p)
  34.                    (if (debug-data? p)
  35.                        (debug-data-uid p)
  36.                        p))
  37.                  (debug-data-pc-in-parent data)
  38.                  (debug-data-env-maps data)
  39.                  ;; Don't retain source code, right?
  40.                  )
  41.                port)
  42.             (newline port))
  43.           (debug-data-table))
  44.       (write '- port) (newline port))))
  45.  
  46. (define (read-debug-info file)
  47.   (call-with-input-file file
  48.     (lambda (port)
  49.  
  50.       (display "Reading ") (display file) (newline)
  51.  
  52.       (let ((read-table
  53.          (lambda (table)
  54.            (let loop ()
  55.          (let ((z (read port)))
  56.            (if (pair? z)
  57.                (begin (table-set! table
  58.                       (car z)
  59.                       (make-immutable! (cadr z)))
  60.                   ;; (set! *location-uid*
  61.                   ;;       (max *location-uid* (+ (car z) 1)))
  62.                   (loop))))))))
  63.     (read-table package-name-table)
  64.     (read-table location-info-table))
  65.  
  66.       (let loop ()
  67.     (let ((z (read port)))
  68.       (if (pair? z)
  69.           (begin ;; (set! *template-uid*
  70.              ;;          (max *template-uid* (+ (car z) 1)))
  71.              (table-set! (debug-data-table)
  72.                  (car z)
  73.                  (make-immutable!
  74.                   (apply make-debug-data
  75.                      (append z '(())))))
  76.              (loop))))))))
  77.  
  78.